home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyInterruptSafeMemory.p < prev    next >
Encoding:
Text File  |  1997-04-05  |  4.0 KB  |  153 lines  |  [TEXT/CWIE]
  1. unit MyInterruptSafeMemory;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.     
  8.     { memory is allocated in chunk_size units }    
  9.     { chunk_size must be a multiple of 16 }
  10.     
  11.     function MemoryPoolCreate( var pool: univ Ptr; size: longint; chunk_size: longint ): OSErr;
  12.     procedure MemoryPoolDestroy( var pool: univ Ptr );
  13.     
  14.     function MemoryPoolAllocate( pool: univ Ptr; var data: Ptr; size: longint ): OSErr;
  15.     procedure MemoryPoolFree( pool: univ Ptr; var data: Ptr );
  16.     
  17. implementation
  18.  
  19.     uses
  20.         OSUtils, Errors, OpenTransport, 
  21.         MyMemory, MyAssertions, MyLowLevel;
  22.  
  23. {$align powerpc}
  24.     type
  25.         CountsArray = array[0..0] of longint;
  26.         CountsArrayPtr = ^CountsArray;
  27.         PoolRecord = record
  28.             chunk_size: longint;
  29.             chunk_count: longint;
  30.             last_checked: longint;
  31.             counts: CountsArrayPtr;
  32.             bits: Ptr;
  33.             data: Ptr;
  34.         end;
  35.         PoolPtr = ^PoolRecord;
  36. {$align reset}
  37.  
  38.     function AtmicClearBit( pp: PoolPtr; bit: longint ): boolean;
  39.     begin
  40.         AtmicClearBit := OTAtomicClearBit( UInt8(AddPtrLong( pp^.bits, bit div 8 )^), bit mod 8 );
  41.     end;
  42.         
  43.     function AtmicSetBit( pp: PoolPtr; bit: longint ): boolean;
  44.     begin
  45.         AtmicSetBit := OTAtomicSetBit( UInt8(AddPtrLong( pp^.bits, bit div 8 )^), bit mod 8 );
  46.     end;
  47.         
  48.     function MemoryPoolCreate( var pool: univ Ptr; size: longint; chunk_size: longint ): OSErr;
  49.         var
  50.             err: OSErr;
  51.             i, chunk_count, bits_size: longint;
  52.             pp: PoolPtr;
  53.             junk_bool: boolean;
  54.     begin
  55.         Assert( (chunk_size > 0) & (size > 0) );
  56.         Assert( chunk_size mod 16 = 0 );
  57.         
  58.         chunk_count := (size + chunk_size - 1) div chunk_size;
  59.         size := chunk_count * chunk_size;
  60.         bits_size := (chunk_count + 31) div 32 * 4;
  61.         err := MNewPtr( pool, SizeOf(PoolRecord) + chunk_count * SizeOf(longint) + bits_size + size );
  62.         if err = noErr then begin
  63.             pp := PoolPtr(pool);
  64.             pp^.chunk_size := chunk_size;
  65.             pp^.chunk_count := chunk_count;
  66.             pp^.last_checked := 0;
  67.             pp^.counts := CountsArrayPtr( AddPtrLong( pool, SizeOf(PoolRecord) ) );
  68.             pp^.bits := AddPtrLong( pp^.counts, chunk_count * SizeOf(longint) );
  69.             pp^.data := AddPtrLong( pp^.bits, bits_size );
  70.             for i := 0 to chunk_count - 1 do begin
  71.                 junk_bool := AtmicClearBit( pp, i );
  72.                 pp^.counts^[i] := 0;
  73.             end;
  74.         end;
  75.         MemoryPoolCreate := err;
  76.     end;
  77.     
  78.     procedure MemoryPoolDestroy( var pool: univ Ptr );
  79.     begin
  80.         MDisposePtr( pool );
  81.     end;
  82.     
  83.     function MemoryPoolAllocate( pool: univ Ptr; var data: Ptr; size: longint ): OSErr;
  84.         var
  85.             err: OSErr;
  86.             i, j, chunks_needed, last_checked, found: longint;
  87.             pp: PoolPtr;
  88.             junk_bool: boolean;
  89.     begin
  90.         Assert( pool <> nil );
  91.         pp := PoolPtr(pool);
  92.         chunks_needed := (size + pp^.chunk_size - 1) div pp^.chunk_size;
  93.         last_checked := pp^.last_checked;
  94.         i := last_checked;
  95.         found := -1;
  96.         repeat
  97.             if i + chunks_needed <= pp^.chunk_count then begin
  98.                 found := i;
  99.                 j := i;
  100.                 while j < i + chunks_needed do begin
  101.                     if AtmicSetBit( pp, j ) then begin
  102.                         while j > i do begin
  103.                             junk_bool := AtmicClearBit( pp, j );
  104.                             Dec(j);
  105.                         end;
  106.                         found := -1;
  107.                         leave;
  108.                     end;
  109.                     Inc(j);
  110.                 end;
  111.                 if found >= 0 then begin
  112.                     leave;
  113.                 end;
  114.             end;
  115.             Inc(i);
  116.             if i = pp^.chunk_count then begin
  117.                 i := 0;
  118.             end;
  119.         until i  = last_checked;
  120.         if found >= 0 then begin
  121.             pp^.counts^[found] := chunks_needed;
  122.             data := AddPtrLong( pp^.data, found * pp^.chunk_size );
  123.             pp^.last_checked := (found + chunks_needed) mod pp^.chunk_count;
  124.             err := noErr;
  125.         end else begin
  126.             data := nil;
  127.             err := memFullErr;
  128.         end;
  129.         MemoryPoolAllocate := err;
  130.     end;
  131.     
  132.     procedure MemoryPoolFree( pool: univ Ptr; var data: Ptr );
  133.         var
  134.             found, count, i: longint;
  135.             pp: PoolPtr;
  136.             junk_bool: boolean;
  137.     begin
  138.         Assert( pool <> nil );
  139.         pp := PoolPtr(pool);
  140.         Assert( SubPtrPtr( data, pp^.data ) mod pp^.chunk_size = 0 );
  141.         found := SubPtrPtr( data, pp^.data ) div pp^.chunk_size;
  142.         Assert( (0 <= found) & (found < pp^.chunk_count) );
  143.         count := pp^.counts^[found];
  144.         Assert( (0 < count) & (found + count <= pp^.chunk_count) );
  145.         for i := found to found + count - 1 do begin
  146.             junk_bool := AtmicClearBit( pp, i );
  147.             Assert( junk_bool );
  148.         end;
  149.         data := nil;
  150.     end;
  151.     
  152. end.
  153.